home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / tp / dnd / trash.pas < prev    next >
Pascal/Delphi Source File  |  1992-04-13  |  4KB  |  171 lines
  1. Program Trash;
  2.  
  3. {$R-,I-,G+,W-,S-,D-,L-}
  4.  
  5. {$R TRASH}
  6.  
  7. Uses
  8.  WinTypes,WinProcs,Win31,ShellAPI,WObjects,Strings;
  9.  
  10. Type
  11.   PTrashWin = ^TTrashWin;
  12.   TTrashWin = Object(TWindow)
  13.                 Procedure SetupWindow;
  14.                   Virtual;
  15.  
  16.                 Function GetClassName : PChar;
  17.                   Virtual;
  18.  
  19.                 Procedure GetWindowClass(Var AWndClass : TWndClass);
  20.                   Virtual;
  21.  
  22.                 Procedure WMQueryOpen(Var Msg : TMessage);
  23.                   Virtual wm_QueryOpen;
  24.  
  25.                 Procedure WMDropFiles(var Msg : TMessage);
  26.                   Virtual wm_first + wm_DropFiles;
  27.  
  28.                 Procedure FileDropped(FileName : PChar;
  29.                                       Var DropPos : TPoint;
  30.                                       InClient : Boolean);
  31.                   Virtual;
  32.               End;
  33.  
  34.  TMyApp = Object(TApplication)
  35.             Procedure InitMainWindow;
  36.               Virtual;
  37.           End;
  38.  
  39. Const
  40.   AppName = 'Trash Can';
  41.  
  42. {---------------------------------------------------}
  43.  
  44. { --- Application Methods --- }
  45.  
  46. Procedure TMyApp.InitMainWindow;
  47.  
  48. Begin
  49.   MainWindow := New(PTrashWin,Init(nil,AppName));
  50. End;
  51.  
  52. {---------------------------------------------------}
  53.  
  54. { --- Window Methods --- }
  55.  
  56. Procedure TTrashWin.SetupWindow;
  57.  
  58. Begin
  59.   TWindow.SetupWindow;
  60.  
  61.   DragAcceptFiles(hWindow,True); { Inform Windows that we accept file drops }
  62. End {SetupWindow};
  63.  
  64. {---------------------------------------------------}
  65.  
  66. Procedure TTrashWin.WMDropFiles;
  67.  
  68. Var
  69.  NumFiles : word;
  70.  FileName : array[0..127] of char;
  71.  i : word;
  72.  DropPoint : TPoint;
  73.  InClientArea : boolean;
  74.  
  75. Begin
  76.  { Msg.wParam contains a handle to the "drop info" }
  77.  
  78.  { First, find out how many files were dropped }
  79.  NumFiles := DragQueryFile(Msg.wParam,$FFFF,Nil,0);
  80.  
  81.  { Next, find out where the file was dropped }
  82.  InClientArea := DragQueryPoint(Msg.wParam,DropPoint);
  83.  
  84.  { Finally, retrieve the dropped files and call the virtual method
  85.    "FileDropped" }
  86.  For i := 0 to Pred(NumFiles) Do
  87.  Begin
  88.    DragQueryFile(Msg.wParam,i,FileName,Pred(Sizeof(FileName)));
  89.    FileDropped(FileName,DropPoint,InClientArea);
  90.  End;
  91.  
  92.  { Cleanup - tell Windows that we're done with the "drop info" }
  93.  DragFinish(Msg.wParam);
  94.  
  95. End {WMDropFiles};
  96.  
  97. {---------------------------------------------------}
  98.  
  99. Procedure TTrashWin.FileDropped(FileName : PChar;
  100.                                        Var DropPos : TPoint;
  101.                                        InClient : Boolean);
  102.  
  103. Var
  104.   TrashFile : File;
  105.   Tx : Array [0..80] of Char;
  106.   Res : Word;
  107.  
  108. Begin
  109.   SetClassWord(HWindow,gcw_HIcon,LoadIcon(HInstance,'CANFLAME'));
  110.   InvalidateRect(HWindow,Nil,True);
  111.  
  112.   StrCopy(Tx,'Trash ');
  113.   StrCat(Tx,FileName);
  114.   StrCat(Tx,'?');
  115.  
  116.   Res := MessageBox(HWindow,Tx,'Trash Can',mb_YesNo or mb_IconQuestion);
  117.  
  118.   If Res = id_Yes
  119.     Then Begin
  120.            SetClassWord(HWindow,gcw_HIcon,LoadIcon(HInstance,'CANDEL'));
  121.            InvalidateRect(HWindow,Nil,True);
  122.            UpdateWindow(HWindow);
  123.  
  124.            Assign(TrashFile,FileName);
  125.            Erase(TrashFile);
  126.          End;
  127.  
  128.   SetClassWord(HWindow,gcw_HIcon,LoadIcon(HInstance,'CAN'));
  129.   InvalidateRect(HWindow,Nil,True);
  130.  
  131. End {FileDropped};
  132.  
  133. {---------------------------------------------------}
  134.  
  135. Procedure TTrashWin.WMQueryOpen(Var Msg : TMessage);
  136.  
  137. Begin
  138.   Msg.Result := 0;       { Deny open }
  139. End {WMQueryOpen};
  140.  
  141. {---------------------------------------------------}
  142.  
  143. Function TTrashWin.GetClassName;
  144.  
  145. Begin
  146.   GetClassName := AppName;
  147. End {GetClassName};
  148.  
  149. {---------------------------------------------------}
  150.  
  151. Procedure TTrashWin.GetWindowClass(Var AWndClass : TWndClass);
  152.  
  153. Begin
  154.   TWindow.GetWindowClass(AWndClass);
  155.  
  156.   AWndClass.hIcon := LoadIcon(HInstance,'CAN');
  157. End {GetWindowClass};
  158.  
  159. {---------------------------------------------------}
  160.  
  161. Var
  162.   MyApp : TMyApp;
  163.  
  164. Begin
  165.   CmdShow := sw_ShowMinNoActive;
  166.  
  167.   MyApp.Init(AppName);
  168.   MyApp.Run;
  169.   MyApp.Done;
  170. End.
  171.